﻿namespace Zipper.Demo

module Pangolin =

    open Zipper.Zipper
    open Zipper.Applications.BinaryTree

    let private questionForGuess x = sprintf "My guess is '%s'. Is that correct?" x
    let private questionForCorrectAnswer = "What animal did you think of?"
    let private questionForDistinguishingQuestion x y = sprintf "Please enter a question to distinguish between '%s' and '%s'!" x y
    let private questionForAnswer x = sprintf "What is the answer for '%s'?" x
    let private questionForAnotherGame = "Do you want to play again?"
    let private requestToThink = "Please think of an animal!"

    let rec private play yesNo ask newLine z =
        let rec guess z =
            match focus z with
                | Leaf x -> z
                | Node (q,l,r) -> guess <| if yesNo q then left z else right z
        let update t =
            match t with
                | Node _ -> failwith "Leaf expected."
                | Leaf x -> if x |> questionForGuess |> yesNo then t
                            else
                                newLine()
                                let y = ask questionForCorrectAnswer
                                let q = questionForDistinguishingQuestion x y |> ask
                                let a = x |> questionForAnswer |> yesNo
                                if a then Node(q, t, Leaf y) else Node(q, Leaf y, t)
  
        ask requestToThink |> ignore
        let z' = z |> guess |> modify update |> top
        newLine()
        if yesNo questionForAnotherGame then newLine(); play yesNo ask newLine z' else z'

    /// Plays Pangolin.
    let pangolin yesNo ask newLine t = t |> unzip |> play yesNo ask newLine |> zip